home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 August / macformat-027.iso / mac / Shareware City / Developers / Oberon⁄F / Omosi / Mod / Views (.txt)
Encoding:
Oberon Document  |  1994-06-07  |  10.7 KB  |  346 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Geneva
  16. Geneva
  17. StdStamps.StdViewDesc
  18. Geneva
  19. MODULE OmosiViews;
  20. (** OmInc 
  21.     IMPORT Domains, Ports, Stores, Models, Views, Controllers, Properties, Dialog;
  22.     CONST
  23.         (* Kind *)
  24.         outside = -1; white = 0; top = 1; left = 2; right = 3;
  25.         version = 0;
  26.     TYPE
  27.         Palette = ARRAY 4 OF Ports.Color;
  28.         Kind = INTEGER;
  29.         Field = RECORD
  30.             kind: Kind;
  31.             sel: BOOLEAN
  32.         END;
  33.         Row = ARRAY 8 OF Field;
  34.         Model = ARRAY 15 OF Row;
  35.         StdView = POINTER TO StdViewDesc;
  36.         StdViewDesc = RECORD (Views.ViewDesc)
  37.             pal: Palette;
  38.             mod: Model;
  39.             sel: INTEGER;
  40.             grid: BOOLEAN
  41.         END;
  42.         FieldPath = ARRAY 3 OF Ports.Point;
  43.         FieldOp = POINTER TO FieldOpDesc;
  44.         FieldOpDesc = RECORD (Domains.OperationDesc)
  45.             v: StdView; i, j: INTEGER; kind: Kind
  46.         END;
  47.         ColorOp = POINTER TO ColorOpDesc;
  48.         ColorOpDesc = RECORD (Domains.OperationDesc)
  49.             v: StdView; n: INTEGER; col: Ports.Color
  50.         END;
  51.         UpdateMsg = RECORD (Views.Message)
  52.             i, j: INTEGER
  53.         END;
  54.     PROCEDURE InitRow (VAR row: Row; k: INTEGER);
  55.         VAR i, l, r: INTEGER;
  56.     BEGIN
  57.         l := (8 - k) DIV 2; r := 8 - l;
  58.         i := 0; WHILE i < l DO row[i].kind := outside; INC(i) END;
  59.         WHILE i < r DO row[i].kind := white; INC(i) END;
  60.         WHILE i < 8 DO row[i].kind := outside; INC(i) END;
  61.         i := 0; WHILE i < 8 DO row[i].sel := FALSE; INC(i) END
  62.     END InitRow;
  63.     PROCEDURE InitPalette (VAR p: Palette);
  64.     BEGIN
  65.         p[white] := Ports.grey12;
  66.         p[top] := Ports.grey25; p[left] := Ports.grey50; p[right] := Ports.grey75;
  67.     END InitPalette;
  68.     PROCEDURE InitModel (VAR m: Model);
  69.         VAR j: INTEGER;
  70.     BEGIN
  71.         InitRow(m[0], 2); InitRow(m[1], 4); InitRow(m[2], 6);
  72.         j := 3; WHILE j < 12 DO InitRow(m[j], 8); INC(j) END;
  73.         InitRow(m[12], 6); InitRow(m[13], 4); InitRow(m[14], 2)
  74.     END InitModel;
  75.     PROCEDURE Init (v: StdView);
  76.     BEGIN
  77.         InitPalette(v.pal); InitModel(v.mod); v.sel := 0; v.grid := TRUE
  78.     END Init;
  79.     PROCEDURE H (s: LONGINT): LONGINT;
  80.     BEGIN
  81.         RETURN s * 500 DIV 866
  82.     END H;
  83.     PROCEDURE S (h: LONGINT): LONGINT;
  84.     BEGIN
  85.         RETURN h * 866 DIV 500
  86.     END S;
  87.     PROCEDURE GetFieldPath (v: StdView; f: Ports.Frame; i, j: INTEGER; VAR p: FieldPath);
  88.         VAR w, h, s: LONGINT; kind: Kind;
  89.     BEGIN
  90.         v.context.GetSize(w, h); s := w DIV 8; h := H(s);
  91.         kind := v.mod[j, i].kind;
  92.         IF ODD(i + j) THEN
  93.             p[0].x := i * s; p[0].y := (j + 1) * h;
  94.             p[1].x := (i + 1) * s; p[1].y := j * h;
  95.             p[2].x := (i + 1) * s; p[2].y := (j + 2) * h
  96.         ELSE
  97.             p[0].x := i * s; p[0].y := j * h;
  98.             p[1].x := (i + 1) * s; p[1].y := (j + 1) * h;
  99.             p[2].x := i * s; p[2].y := (j + 2) * h
  100.         END
  101.     END GetFieldPath;
  102.     PROCEDURE ValidField (v: StdView; i, j: INTEGER): BOOLEAN;
  103.     BEGIN
  104.         RETURN (0 <= i) & (i < 8) & (0 <= j) & (j < 15) & (v.mod[j, i].kind > outside)
  105.     END ValidField;
  106.     PROCEDURE DrawField (v: StdView; f: Ports.Frame; i, j: INTEGER);
  107.         VAR col: Ports.Color; p: FieldPath;
  108.     BEGIN
  109.         IF ValidField(v, i, j) THEN
  110.             col := v.pal[v.mod[j, i].kind]; GetFieldPath(v, f, i, j, p);
  111.             f.DrawPath(p, 3, Ports.fill, col, Ports.closedPoly);
  112.             IF v.mod[j, i].sel THEN
  113.                 f.DrawPath(p, 3, 0, Ports.black, Ports.closedPoly)
  114.             ELSIF v.grid THEN
  115.                 f.DrawPath(p, 3, 0, Ports.white, Ports.closedPoly)
  116.             ELSE
  117.                 f.DrawPath(p, 3, 0, col, Ports.closedPoly)
  118.             END
  119.         END
  120.     END DrawField;
  121.     PROCEDURE SelectField (v: StdView; f: Ports.Frame; i, j: INTEGER; sel: BOOLEAN);
  122.         VAR col: Ports.Color; p: FieldPath; kind: Kind;
  123.     BEGIN
  124.         IF ValidField(v, i, j) & (v.mod[j, i].sel # sel) THEN
  125.             v.mod[j, i].sel := sel;
  126.             IF sel THEN INC(v.sel) ELSE DEC(v.sel) END;
  127.             DrawField(v, f, i, j)
  128.         END
  129.     END SelectField;
  130.     PROCEDURE LocateField (v: StdView; f: Views.Frame; x, y: LONGINT; VAR i, j: INTEGER);
  131.         VAR u, w, h, s, sx, sy, mx, my: LONGINT;
  132.     BEGIN
  133.         v.context.GetSize(w, h); s := w DIV 8;
  134.         u := f.unit; h := H(s);
  135.         sx := x DIV s; sy := y DIV h;
  136.         IF (0 <= sx) & (sx < 9) & (0 <= sy) & (sy < 16) THEN
  137.             i := SHORT(sx); j := SHORT(sy);
  138.             IF ODD(i + j) THEN
  139.                 IF (s - x) MOD s * (h DIV u) >= y MOD h * (s DIV u) THEN DEC(j) END
  140.             ELSE
  141.                 IF x MOD s * (h DIV u) >= y MOD h * (s DIV u) THEN DEC(j) END
  142.             END;
  143.             IF (i = 8) OR (j = 15) OR (j >= 0) & (v.mod[j, i].kind = outside) THEN j := -1 END
  144.         ELSE j := -1
  145.         END
  146.     END LocateField;
  147.     PROCEDURE Select (v: StdView; set: BOOLEAN);
  148.         VAR i, j, sel: INTEGER;
  149.     BEGIN
  150.         j := 0;
  151.         WHILE j < 15 DO
  152.             i := 0; WHILE i < 8 DO v.mod[j, i].sel := set; INC(i) END;
  153.             INC(j)
  154.         END;
  155.         IF set THEN sel := 64 ELSE sel := 0 END;
  156.         IF v.sel # sel THEN v.sel := sel; Views.Update(v, Views.keepFrames) END
  157.     END Select;
  158.     PROCEDURE Track (v: StdView; f: Views.Frame; x, y: LONGINT; buttons: SET);
  159.         VAR script: Domains.Operation; op: FieldOp; cop: ColorOp; col: Ports.Color;
  160.             i, j, i0, j0, i1, j1: INTEGER; isDown, prevSel, setCol: BOOLEAN;
  161.     BEGIN
  162.         LocateField(v, f, x, y, i, j); i0 := i; j0 := j; prevSel := ValidField(v, i, j) & v.mod[j, i].sel;
  163.         SelectField(v, f, i, j, TRUE);
  164.         REPEAT
  165.             f.Input(x, y, isDown);
  166.             LocateField(v, f, x, y, i1, j1); 
  167.             IF (i1 # i) OR (j1 # j) THEN
  168.                 IF ~(Controllers.extend IN buttons) THEN SelectField(v, f, i, j, FALSE) END;
  169.                 i := i1; j := j1;
  170.                 SelectField(v, f, i, j, TRUE)
  171.             END
  172.         UNTIL ~isDown;
  173.         IF ~(Controllers.extend IN buttons) & ((i # i0) OR (j # j0) OR ~prevSel) THEN
  174.             SelectField(v, f, i, j, FALSE)
  175.         END;
  176.         IF ValidField(v, i, j) THEN
  177.             IF Controllers.modify IN buttons THEN
  178.                 Dialog.GetColor(v.pal[v.mod[j, i].kind], col, setCol);
  179.                 IF setCol THEN
  180.                     NEW(cop); cop.v := v; cop.n := v.mod[j, i].kind; cop.col := col;
  181.                     Views.Do(v, "Color Change", cop)
  182.                 END
  183.             ELSIF ~(Controllers.extend IN buttons) THEN
  184.                 Views.BeginScript(v, "Isomo Change", script);
  185.                 j := 0;
  186.                 WHILE j < 15 DO
  187.                     i := 0;
  188.                     WHILE i < 8 DO
  189.                         IF (v.mod[j, i].sel OR (i = i1) & (j = j1)) & (v.mod[j, i].kind > outside) THEN
  190.                             NEW(op); op.v := v; op.i := i; op.j := j;
  191.                             op.kind := (v.mod[j, i].kind + 1) MOD 4;
  192.                             Views.Do(v, "", op)
  193.                         END;
  194.                         INC(i)
  195.                     END;
  196.                     INC(j)
  197.                 END;
  198.                 Views.EndScript(v, script)
  199.             END
  200.         ELSE Select(v, FALSE)
  201.         END
  202.     END Track;
  203.     (* FieldOp *)
  204.     PROCEDURE (op: FieldOp) Do;
  205.         VAR k: Kind; msg: UpdateMsg;
  206.     BEGIN
  207.         k := op.v.mod[op.j, op.i].kind;
  208.         op.v.mod[op.j, op.i].kind := op.kind;
  209.         op.kind := k;
  210.         msg.i := op.i; msg.j := op.j; Views.Broadcast(op.v, msg)
  211.     END Do;
  212.     (* ColorOp *)
  213.     PROCEDURE (op: ColorOp) Do;
  214.         VAR c: Ports.Color;
  215.     BEGIN
  216.         c := op.v.pal[op.n]; op.v.pal[op.n] := op.col; op.col := c;
  217.         Views.Update(op.v, Views.keepFrames)
  218.     END Do;
  219.     (* View *)
  220.     PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
  221.         VAR i, j: INTEGER;
  222.     BEGIN
  223.         v.Externalize^(wr);
  224.         wr.WriteVersion(version);
  225.         i := 0; WHILE i < 4 DO wr.WriteLInt(v.pal[i]); INC(i) END;
  226.         j := 0;
  227.         WHILE j < 15 DO
  228.             i := 0; WHILE i < 8 DO wr.WriteInt(v.mod[j, i].kind); INC(i) END;
  229.             INC(j)
  230.         END
  231.     END Externalize;
  232.     PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
  233.         VAR i, j: INTEGER; ver: SHORTINT;
  234.     BEGIN
  235.         v.Internalize^(rd);
  236.         IF rd.cancelled THEN RETURN END;
  237.         rd.ReadVersion(version, version, ver);
  238.         IF rd.cancelled THEN RETURN END;
  239.         i := 0; WHILE i < 4 DO rd.ReadLInt(v.pal[i]); INC(i) END;
  240.         j := 0;
  241.         WHILE j < 15 DO
  242.             i := 0; WHILE i < 8 DO rd.ReadInt(v.mod[j, i].kind); v.mod[j, i].sel := FALSE; INC(i) END;
  243.             INC(j)
  244.         END;
  245.         v.grid := FALSE
  246.     END Internalize;
  247.     PROCEDURE (v: StdView) CopyFrom (source: Views.View);
  248.     BEGIN
  249.         v.CopyFrom^(source);
  250.         WITH source: StdView DO
  251.             v.pal := source.pal; v.mod := source.mod;
  252.             v.sel := source.sel; v.grid := FALSE
  253.         END
  254.     END CopyFrom;
  255.     PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  256.         VAR i, j: INTEGER;
  257.     BEGIN
  258.         j := 0;
  259.         WHILE j < 15 DO
  260.             i := 0; WHILE i < 8 DO DrawField(v, f, i, j); INC(i) END;
  261.             INC(j)
  262.         END
  263.     END Restore;
  264.     PROCEDURE (v: StdView) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
  265.     BEGIN
  266.         WITH msg: UpdateMsg DO
  267.             DrawField(v, f, msg.i, msg.j)
  268.         ELSE
  269.         END
  270.     END HandleViewMsg;
  271.     PROCEDURE (v: StdView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
  272.                                                                 VAR focus: Views.View);
  273.         VAR i, j, sel: INTEGER;
  274.     BEGIN
  275.         WITH msg: Controllers.TrackMsg DO
  276.             Track(v, f, msg.x, msg.y, msg.modifiers)
  277.         | msg: Controllers.PollOpsMsg DO
  278.             msg.selectable := TRUE; msg.deselectable := TRUE; msg.valid := {Controllers.copy}
  279.         | msg: Controllers.EditMsg DO
  280.             IF msg.op = Controllers.copy THEN
  281.                 msg.view := Views.CopyOf(v, Views.deep); v.context.GetSize(msg.w, msg.h)
  282.             END
  283.         | msg: Controllers.SelectMsg DO
  284.             Select(v, msg.set)
  285.         ELSE
  286.         END
  287.     END HandleCtrlMsg;
  288.     PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
  289.     BEGIN
  290.         WITH msg: Properties.SizePref DO
  291.             IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
  292.                 Properties.ProportionalConstraint(1000, 2 * H(1000), msg.w, msg.h)
  293.             ELSE
  294.                 msg.w := 8 * (7 * Ports.mm); msg.h := 16 * H(7 * Ports.mm)
  295.             END;
  296.             INC(msg.h, 1 * Ports.mm)
  297.         ELSE
  298.         END
  299.     END HandlePropMsg;
  300.     (* commands *)
  301.     PROCEDURE Deposit*;
  302.         VAR v: StdView;
  303.     BEGIN
  304.         NEW(v); v.Init; Init(v); Views.Deposit(v)
  305.     END Deposit;
  306.     PROCEDURE ToggleGrid*;
  307.         VAR v: Views.View;
  308.     BEGIN
  309.         v := Controllers.FocusView();
  310.         IF v # NIL THEN
  311.             WITH v: StdView DO
  312.                 v.grid := ~v.grid; Views.Update(v, Views.keepFrames)
  313.             ELSE
  314.             END
  315.         END 
  316.     END ToggleGrid;
  317.     PROCEDURE ResetColors*;
  318.         VAR v: Views.View; p0: Palette; script: Domains.Operation; cop: ColorOp; i: INTEGER;
  319.     BEGIN
  320.         v := Controllers.FocusView();
  321.         IF v # NIL THEN
  322.             WITH v: StdView DO
  323.                 Views.BeginScript(v, "Reset Colors", script);
  324.                 InitPalette(p0);
  325.                 i := 0;
  326.                 WHILE i < 4 DO
  327.                     NEW(cop); cop.v := v; cop.n := i; cop.col := p0[i]; Views.Do(v, "", cop); INC(i)
  328.                 END;
  329.                 Views.EndScript(v, script)
  330.             ELSE
  331.             END
  332.         END 
  333.     END ResetColors;
  334. END OmosiViews.
  335. TextControllers.StdCtrlDesc
  336. TextControllers.ControllerDesc
  337. Containers.ControllerDesc
  338. Controllers.ControllerDesc
  339. TextRulers.StdRulerDesc
  340. TextRulers.RulerDesc
  341. TextRulers.StdStyleDesc
  342. TextRulers.StyleDesc
  343. TextRulers.AttributesDesc
  344. Geneva
  345. Documents.ControllerDesc
  346.